home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr11 / gedvw105.zip / FGS.PRG < prev    next >
Text File  |  1995-03-05  |  2KB  |  166 lines
  1. *
  2. *    This creates a simple Family Group Chart from a FAM record
  3. *
  4. *    for GEDView 1.05
  5. *    by michael@genealogy.emcee.com - 3 Mar 1995
  6. *
  7. get line
  8. compare $FIELD3 fam
  9. iffailed
  10.     end
  11. remember RECORD
  12. set bell off
  13. save fgs.txt "\J"
  14.  
  15. go husb
  16. iffailed
  17.     goto do_wife
  18. append fgs.txt "   Father: "
  19. gosub calls
  20.  
  21. :do_wife
  22.     go wife
  23.     iffailed
  24.         goto continue
  25.     append fgs.txt "   Mother: "
  26.     gosub calls
  27.  
  28. :continue
  29.     gosub do_marriage
  30.     gosub do_line
  31.     gosub get-children
  32.     gosub do_line
  33.     append fgs.txt " Compiler: Anybody Jones               GEDView beta version 1.05\J"
  34.     append fgs.txt "    Email: anybody@emcee.com\J\J"
  35.     system type fgs.txt
  36.     go record
  37.     set bell on
  38.     end
  39.  
  40. :do_line
  41.     append fgs.txt "-----------------------------------------------------------------\J"
  42.     return
  43.  
  44. :calls
  45.     gosub do_name
  46.     gosub do_birth
  47.     gosub do_death
  48.     gosub do_burial
  49.     go RECORD
  50.     return
  51.  
  52. :do_name
  53.     get name
  54.     iffailed
  55.         return
  56.     fixname $FIELD3
  57.     append fgs.txt $FULLNAME
  58.     append fgs.txt "\J"
  59.     return
  60.  
  61. :do_birth
  62.     get birt
  63.     iffailed
  64.         return
  65.     gosub get-data
  66.     append fgs.txt "\J"
  67.     return
  68.  
  69. :do_marriage
  70.     get marr
  71.     iffailed
  72.         return
  73.     gosub get-data
  74.     append fgs.txt "\J"
  75.     return
  76.  
  77. :do_death
  78.     get deat
  79.     iffailed
  80.         return
  81.     gosub get-data
  82.     append fgs.txt "\J"
  83.     return
  84.  
  85. :do_burial
  86.     get buri
  87.     iffailed
  88.         return
  89.     gosub get-data
  90.     append fgs.txt "\J"
  91.     return
  92.  
  93. :get-data
  94.     set #width 11
  95. *    append fgs.txt $LABEL "
  96. *    append fgs.txt ": "
  97. append fgs.txt "$LABEL: "
  98.     get next line
  99.     set #width -0
  100.     compare $FIELD2 date
  101.     ifequal
  102.         gosub print-date
  103.     compare $FIELD2 plac
  104.     iffailed
  105.         return
  106.     append fgs.txt " at "
  107.     append fgs.txt $FIELD3
  108.     return
  109.  
  110. :print-date
  111.     append fgs.txt $FIELD3
  112.     get next line
  113.     return
  114.  
  115. :get-children
  116.     get chil
  117.     iffailed
  118.         return
  119.     append fgs.txt " Children: "
  120.     remember LINENO
  121.  
  122. :loop
  123.     ifescape
  124.         return
  125.     fixpointer #field3
  126.     go indi $FIELD3
  127.     get name
  128.     fixname $FIELD3
  129.     set #width -0
  130.     append fgs.txt $FIRSTNAME
  131.     gosub get-childs-data
  132.     append fgs.txt "\J"
  133.     go RECORD
  134.     go LINENO
  135.     get next chil
  136.     iffailed
  137.         return
  138.     remember LINENO
  139.     append fgs.txt "           "
  140.     goto loop
  141.  
  142. :get-childs-data
  143.  
  144.     get birt
  145.     iffailed
  146.         return
  147.     get next line
  148.     compare $FIELD2 date
  149.     ifequal
  150.         gosub print-date2
  151.  
  152.     get deat
  153.     iffailed
  154.         return
  155.     append fgs.txt " - "
  156.     get next line
  157.     compare $FIELD2 date
  158.     ifequal
  159.         append fgs.txt $FIELD3
  160.     return
  161.  
  162. :print-date2
  163.     append fgs.txt ", "
  164.     append fgs.txt $FIELD3
  165.     return
  166.